perm filename DATUM.SAI[PUB,SYS] blob
sn#200327 filedate 1976-10-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00021 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGOF("DATUM")
C00004 00003 IFK PASSONE THENK
C00007 00004 IFK PASSONE THENK
C00009 00005 IFK PASSONE THENK
C00011 00006 IFK PASSONE THENK
C00012 00007 IFK PASSONE THENK
C00013 00008 IFK PASSONE OR PASSTWO THENK
C00014 00009 IFK PASSONE THENK
C00015 00010 IFK PASSONE THENK
C00016 00011 IFK PASSONE THENK
C00017 00012 IFK PASSONE THENK
C00018 00013 IFK PASSONE THENK
C00019 00014 IFK PASSONE THENK
C00020 00015 IFK PASSONE THENK
C00021 00016 IFK PASSONE THENK
C00022 00017 IFK PASSONE THENK
C00023 00018 IFK PASSONE OR PASSTWO THENK
C00024 00019 IFK PASSONE THENK
C00025 00020 IFK PASSONE THENK
C00026 00021 IFK PASSONE THENK
C00027 ENDMK
C⊗;
BEGOF("DATUM")
IFC PASSONE THENC
COMMENT
DAN SWINEHART'S EXPANDABLE ARRAY PACKAGE
Declares
IDA ← [S]CREATE(LOWBND, HIGHBND) to create a (string or) integer array
MAKEBE(IDA,ALIAS) to give its descriptor to array ALIAS
IDA ← [S]WHATIS(ALIAS) to take it back
GOAWAY(IDA) to destroctulate it
IDA ← [S]BIGGER(IDA,XTRA) to add XTRA words to its length.
PLUS some of our own functions to PUSH records onto stacks and to PUT
records onto heaps (herein called TBLs).
;
ENDC
EXTERNAL INTEGER GOGTAB ;
PROCEDURES
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE DATUM! ;$"#
BEGIN "DATUM!"
WISTK←WHATIS(ISTK) ; WITBL←WHATIS(ITBL) ; WINEST←WHATIS(INEST) ;
WSSTK←SWHATIS(SSTK) ; WSTBL←SWHATIS(STBL) ; WSNEST←SWHATIS(SNEST) ;
WSYM←SWHATIS(SYM) ; WNUMBER←WHATIS(NUMBER) ; WOLDPAGE←WHATIS(OLDPAGE) ;
WNEWPAGE←WHATIS(NEWPAGE) ; WTHISFRAME←WHATIS(THISFRAME);
WMOLES←WHATIS(MOLES) ; WOWLS←WHATIS(OWLS) ; WNMOLES←WHATIS(NMOLES) ;
WNOWLS←WHATIS(NOWLS) ; WTHISAREA←WHATIS(THISAREA) ; WWAITBOX←WHATIS(WAITBOX) ;
WAVAILREC←WHATIS(AVAILREC) ; WAA←WHATIS(AA) ; WNAA←WHATIS(NAA) ;
WSHORT←WHATIS(SHORT) ; WNSHORT←WHATIS(NSHORT) ;
WMLEAD←WHATIS(MLEAD) ; WNMLEAD←WHATIS(NMLEAD) ; TES 11/2/74 ;
ITBLIDA ← RH(CREATE(0, ITSIZE)) ; ISTKIDA ← RH(CREATE(0, ISIZE)) ; INESTIDA ← RH(CREATE(0, SIZE)) ;
STBLIDA ← RH(SCREATE(0, STSIZE)) ; SSTKIDA ← RH(SCREATE(0, SSIZE)) ; SNESTIDA ← RH(SCREATE(0, SIZE)) ;
SYMIDA ← RH(SCREATE(-1, SYMNO)) ; NUMBIDA ← RH(CREATE(-1, SYMNO)) ;
MAKEBE(ITBLIDA, ITBL) ; MAKEBE(ISTKIDA, ISTK) ; MAKEBE(INESTIDA, INEST) ;
SMAKEBE(STBLIDA, STBL) ; SMAKEBE(SSTKIDA, SSTK) ; SMAKEBE(SNESTIDA, SNEST) ;
SMAKEBE(SYMIDA, SYM) ; MAKEBE(NUMBIDA, NUMBER) ;
LAST ← IHED ← SHED ← IHIGH ← SHIGH ← 0 ; comment Tops of Stacks;
OLDPGIDA←NEWPGIDA←FRAMEIDA←
MOLESIDA←MLEADIDA←SHORTIDA←OWLSIDA←
AREAIDA←WBOXIDA←STATUS←AREAIXM←0 ;
END "DATUM!" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE FINIDATUM ;$"#
BEGIN "FINIDATUM"
FOR J ← ITBLIDA, ISTKIDA, INESTIDA, NUMBIDA DO GOAWAY(J) ;
FOR J ← STBLIDA, SSTKIDA, SNESTIDA, SYMIDA DO GOAWAY(-1 LSH 18 + J) ;
FOR J ← 1 THRU 35 DO IF FNTFIL[J] NEQ 0 THEN GOAWAY(FNTFIL[J]) ;
MAKEBE(WCW,CW);
MAKEBE(WISTK, ISTK) ; MAKEBE(WITBL, ITBL) ; MAKEBE(WINEST, INEST) ;
SMAKEBE(WSSTK, SSTK) ; SMAKEBE(WSTBL, STBL) ; SMAKEBE(WSNEST, SNEST) ;
SMAKEBE(WSYM, SYM) ; MAKEBE(WNUMBER, NUMBER) ; MAKEBE(WOLDPAGE, OLDPAGE) ;
MAKEBE(WNEWPAGE, NEWPAGE) ; MAKEBE(WTHISFRAME,THISFRAME);
MAKEBE(WMOLES, MOLES) ; MAKEBE(WOWLS, OWLS) ; MAKEBE(WNMOLES, NMOLES) ;
MAKEBE(WSHORT, SHORT) ; MAKEBE(WNSHORT, NSHORT) ;
MAKEBE(WMLEAD, MLEAD) ; MAKEBE(WNMLEAD, NMLEAD) ; TES 11/2/74 ;
MAKEBE(WNOWLS, NOWLS) ; MAKEBE(WTHISAREA, THISAREA) ; MAKEBE(WWAITBOX, WAITBOX) ;
MAKEBE(WAVAILREC, AVAILREC) ; MAKEBE(WAA, AA) ; MAKEBE(WNAA, NAA) ;
END "FINIDATUM" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER PROCEDURE BIGGER(INTEGER PTR,HM) ;$"#
BEGIN "BIGGER"
INTEGER PT,L,U,OLDXIDA,NEWXIDA;
INTEGER ARRAY OLDX,NEWX[0:ONE];
OLDXIDA←WHATIS(OLDX);
NEWXIDA←WHATIS(NEWX);
MAKEBE(PTR,OLDX);
L←ARRINFO(OLDX,1);
U←ARRINFO(OLDX,2);
PT←LRMAK(L,U+HM,1);
MAKEBE(PT,NEWX);
ARRTRAN(NEWX,OLDX);
MAKEBE(OLDXIDA,OLDX);
MAKEBE(NEWXIDA,NEWX);
GOAWAY(PTR);
RETURN(PT);
END "BIGGER";
ENDC
IFK PASSONE THENK
PUBLIC INTEGER PROCEDURE BIGGR2(INTEGER PTR,HM) ;$"#
BEGIN "BIGGR2"
INTEGER PT,L,U,OLDXIDA,NEWXIDA;
INTEGER ARRAY OLDX,NEWX[1:ONE,0:ONE];
OLDXIDA←WHATIS(OLDX);
NEWXIDA←WHATIS(NEWX);
MAKEBE(PTR,OLDX);
L←ARRINFO(OLDX,1);
U←ARRINFO(OLDX,2);
PT ← CREATE2(L,U, ARRINFO(OLDX,3), HM+ARRINFO(OLDX,4)) ;
MAKEBE(PT,NEWX);
ARRTRAN(NEWX,OLDX);
MAKEBE(OLDXIDA,OLDX);
MAKEBE(NEWXIDA,NEWX);
GOAWAY(PTR);
RETURN(PT);
END "BIGGR2";
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE CREATE2(INTEGER LB1, UB1, LB2, UB2) ;$"#
BEGIN "CREATE2"
SIMPLE EXTERNAL INTEGER PROCEDURE LRMAK(INTEGER LB1,UB1,LB2,UB2,D) ;
START!CODE MOVE '15, GOGTAB END ; COMMENT LRCOP BUG ;
RETURN(LRMAK(LB1, UB1, LB2, UB2, 2)) ;
END "CREATE2" ;
ENDC
IFK PASSONE OR PASSTWO THENK
PUBLIC SIMPLE PROCEDURE GOAWAY(INTEGER I) ;$"#
BEGIN COMMENT Be SURE Left Half is -1 for String Arrays! ;
START!CODE MOVE '15, GOGTAB END ;
IF 0 LAND LH(I) THEN COMMENT This code looks totally wrong. REG 1/30/76;
START!CODE "SARID"
HRRZ 1, I ; MOVE 1, 0(1) ; COMMENT [PREV,,NEXT] ;
HLRZ 2, 1 ; HRRM 1, 0(2) ; COMMENT PREV ← [...,,NEXT] ;
HRRZ 2, 1 ; SKIPE 2 ; HLLM 1, 0(2) ; COMMENT NEXT←[PREV,,...] ;
END "SARID" ;
ARYEL(I) ;
END "GOAWAY" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE GROW(REFERENCE INTEGER ARRAY ARR; REFERENCE INTEGER IDA,WDS;
INTEGER EXTRA; STRING WHY) ;$"#
BEGIN "GROW"
IDA ← RH(BIGGER(WHATIS(ARR),EXTRA)); WDS ← WDS + EXTRA ;
IF WDS GEQ TWO(14) THEN WARN(NULL,"Table grown to 2↑14 entries. Utterly unmanageable. Goodbye!") ;
END "GROW" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUSHI(INTEGER WDS, TYP) ;$"#
BEGIN "PUSHI"
INTEGER QI ;
IF (IHED ← IHED + WDS+1) > ISIZE THEN
BEGIN
GROW(ISTK, ISTKIDA, ISIZE, 1000, NULL) ;
MAKEBE(ISTKIDA,ISTK)
END ;
ISTK[IHED] ← TYP ROT -9 LOR (IHED-WDS-1) ;
ZEROWORDS(WDS, ISTK[IHED-WDS]) ; RETURN(IHED) ;
END "PUSHI" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUSHS(INTEGER WDS; STRING FIRST) ;$"#
BEGIN"PUSHS"
INTEGER QI ;
IF (SHED ← SHED + WDS) > SSIZE THEN
BEGIN
SGROW(SSTK, SSTKIDA, SSIZE, 200, NULL) ;
SMAKEBE(SSTKIDA,SSTK) ; ZEROSTRINGS(200, SSTK[SSIZE-199]) ;
END ;
SSTK[SHED] ← FIRST ;
FOR QI←WDS-1 DOWN 1 DO SSTK[SHED-QI]←NULL ; RETURN(SHED) ;
END "PUSHS" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUTI(INTEGER WDS, FIRST) ;$"#
BEGIN"PUTI"
INTEGER QI ;
IF (IHIGH ← IHIGH + WDS) > ITSIZE THEN
BEGIN
GROW(ITBL, ITBLIDA, ITSIZE, 300, NULL) ;
MAKEBE(ITBLIDA,ITBL) ;
END ;
ITBL[IHIGH] ← FIRST ;
ZEROWORDS(WDS-1, ITBL[IHIGH-WDS+1]) ; RETURN(IHIGH) ;
END "PUTI" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUTS(STRING VAL) ;$"#
BEGIN"PUTS"
INTEGER QI ;
IF (SHIGH ← SHIGH + 1) > STSIZE THEN
BEGIN
SGROW(STBL, STBLIDA, STSIZE, 200, NULL) ;
SMAKEBE(STBLIDA,STBL) ; ZEROSTRINGS(200, STBL[STSIZE-199]) ;
END ;
STBL[SHIGH] ← VAL ;
RETURN(SHIGH) ;
END "PUTS" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER PROCEDURE SBIGGER(INTEGER PTR,HM) ;$"#
BEGIN "SBIGGER"
EXTERNAL INTEGER PROCEDURE ARRINFO(STRING ARRAY S; INTEGER I);
EXTERNAL PROCEDURE ARRTRAN(STRING ARRAY S1,S2);
INTEGER PT,L,U,SOLDIDA,SNEWIDA;
STRING ARRAY SOLD,SNEW[0:ONE];
SOLDIDA←SWHATIS(SOLD);
SNEWIDA←SWHATIS(SNEW);
SMAKEBE(PTR,SOLD);
L←ARRINFO(SOLD,1);
U←ARRINFO(SOLD,2);
PT←LRMAK(L,U+HM,-1 LSH 18 + 1);
SMAKEBE(PT,SNEW);
ARRTRAN(SNEW,SOLD);
MAKEBE(SOLDIDA,SOLD);
MAKEBE(SNEWIDA,SNEW);
GOAWAY(PTR);
RETURN(PT);
END "SBIGGER";
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE SCREATE(INTEGER LB1, UB1) ;$"#
BEGIN "SCREATE"
INTEGER IDA ;
START!CODE MOVE '15, GOGTAB END ;
IDA ← LRMAK(LB1, UB1, -1 LSH 18 + 1) ;
RETURN(IDA) ;
END "SCREATE" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE SGROW(REFERENCE STRING ARRAY ARR; REFERENCE INTEGER IDA,WDS ;
INTEGER EXTRA; STRING WHY) ;$"#
BEGIN "SGROW"
IDA ← RH(SBIGGER(SWHATIS(ARR),EXTRA)); WDS ← WDS + EXTRA ;
IF WDS GEQ TWO(14) THEN WARN(NULL,"Table grown to 2↑14 entries. Utterly unmanageable. Goodbye!") ;
END "SGROW" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE SWHATIS(STRING ARRAY A) ;$"#
START!CODE "SWHATIS"
MOVE 1,A;
END "SWHATIS";
ENDC
IFK PASSONE OR PASSTWO THENK
PUBLIC INTEGER SIMPLE PROCEDURE WHATIS(INTEGER ARRAY A) ;$"#
START!CODE "WHATIS"
MOVE 1,A;
END "WHATIS";
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE ZEROSTRINGS(INTEGER STRS; REFERENCE STRING LOCN) ;$"#
BEGIN
START!CODE "ZOS"
LABEL DUN ;
SKIPG 1, STRS ;
JRST DUN ; COMMENT NO STRS TO ZERO -- QUIT ;
ADD 1, 1 ; COMMENT TWO WORDS PER STRING ;
HRRZ 2, -1('17) ; COMMENT LOCN ;
SUBI 2, 1 ; COMMENT POINT TO COUNT WORD FIRST ;
SETZM 0(2) ;
ADDI 1, -1(2) ;
HRL 2, 2 ;
ADDI 2, 1 ;
BLT 2, (1) ;
DUN:
END ;
END "ZEROSTRINGS" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE ZEROWORDS(INTEGER WDS; REFERENCE INTEGER LOCN) ;$"#
BEGIN "ZEROWORDS"
START!CODE "ZOT"
LABEL DUN ;
SKIPG 1, WDS ;
JRST DUN ; COMMENT NO WDS TO ZERO -- QUIT ;
HRRZ 2, -1('17) ; COMMENT LOCN ;
SETZM 0(2) ;
CAIN 1, 1 ;
JRST DUN ; COMMENT ONLY 1 -- DON'T BLT ! ;
ADDI 1, -1(2) ;
HRL 2, 2 ;
ADDI 2, 1 ;
BLT 2, (1) ;
DUN:
END ;
END "ZEROWORDS" ;
ENDC
IFK PASSONE THENK
FINISHED
ENDOF("DATUM")
ENDC